#!/bin/sh
# \
exec tclsh "$0" ${1+"$@"}

#
# Copyright (c) 2007, Blair Kitchen.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

# Package dependencies
package require Tcl 8.4
package require sqlite3 3.3
package require svndump 0.1

# Package information
package provide app-index 1.0

# Global arrays
array set state {}
array set opts {}

#
# Main procedure
#
proc main {argc argv} {
   if {$argc != 2} {
      puts "Usage: [info script] <repository-path> <database-file>"
      exit -1
   }
   
   foreach {repositoryPath databaseFile} $argv break
   
   set ::opts(repositoryPath) $repositoryPath
   set ::opts(databaseFile) $databaseFile
   
   set ::state(db) [initializeDatabase $databaseFile]
   
   $::state(db) eval {BEGIN TRANSACTION}
   
   index $repositoryPath
   
   # Commit remaining transactions and close database
   $::state(db) eval {COMMIT TRANSACTION}
   $::state(db) close
}

#
# Procedure to open an initialize the database file
#
proc initializeDatabase {fileName} {
   set dbCmd db
   sqlite3 $dbCmd $fileName
   
   # See if the database needs to be created
   if {[$dbCmd onecolumn {PRAGMA user_version}] eq "0"} {
      $dbCmd eval {
         CREATE TABLE files (
            id INTEGER PRIMARY KEY,
            path VARCHAR(255) COLLATE NOCASE
         );
         CREATE INDEX files_path ON files (path ASC);
         
         CREATE VIRTUAL TABLE file_contents USING FTS1 (
            id INTEGER PRIMARY KEY,
            content TEXT
         );
         
         PRAGMA user_version=1;
      }
   }
   
   return $dbCmd
}

#
# Procedure to perform indexing of the specified repository path
#
proc index {repositoryPath} {
   set inChan [open "|svnadmin dump -rHEAD $repositoryPath" r]
   fconfigure $inChan -translation binary

   svndump::parse $inChan parseDumpFile
}

#
# The following series of procedures are used for parsing dump file output
#
proc parseDumpFile {args} {
   set subCmd "parseDumpFile_[lindex $args 0]"
   set args [lrange $args 1 end]
   
   if {[info commands $subCmd] eq $subCmd} {
      eval $subCmd [list $args]
   }
}

proc parseDumpFile_beginNode {path} {
   set ::state(node,path) $path
}

proc parseDumpFile_endNode {path} {
   # Only index text files
   if {[isNodeTextFile] && [info exists ::state(node,contents)]} {
      indexFileNode $::state(node,path) $::state(node,contents)
   }
   
   # Clear out parse state
   foreach key [array names ::state node,*] {
      unset ::state($key)
   }
}

proc parseDumpFile_beginPropertyContent {propName} {
   # We really only care about the mime type, as it is used to determine
   # how to index the file.
   if {$propName eq "svn:mime-type"} {
      set ::state(node,parseProperty) true
   } else {
      set ::state(node,parseProperty) false
   }
}

proc parseDumpFile_processPropertyContent {data} {
   # Assume we're parsing the mime type
   if {$::state(node,parseProperty)} {
      append ::state(node,mimeType) $data
   }
}

proc parseDumpFile_processTextContent {data} {
   # Only parse file contents when dealing with a text file
   if {[isNodeTextFile]} {
      append ::state(node,contents) $data
   }
}

#
# Determines whether the currently parsed node is a text file, based on svn:mime-type
# property
#
proc isNodeTextFile {} {
   if {[info exists ::state(node,mimeType)]} {
      if {![regexp {text\/} $::state(node,mimeType)]} {
         return false
      }
   }
   
   return true
}

proc indexFileNode {path content} {
   if {![info exists ::state(insertsSinceLastCommit)]} {
      set :::state(insertsSinceLastCommit) 0
   }
   
   $::state(db) eval {
      INSERT INTO files (path) VALUES ($path);
      INSERT INTO file_contents (id, content) VALUES(last_insert_rowid(), $content);
   }

   puts "Indexing $path"
   
   incr ::state(insertsSinceLastCommit)
   if {$::state(insertsSinceLastCommit) == 5000} {
      set ::state(insertsSinceLastCommit 0
      $::state(db) eval {COMMIT TRANSACTION; BEGIN TRANSACTION;}
   }
}

# Switch these comments to enable debug output
#proc debug {body} {}
proc debug {body} { uplevel $body }

main $argc $argv
